home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Frameworks / TransSkel 3.24 / Demos / Pascal Demos / MultiSkel / MSkelRgn.p < prev    next >
Text File  |  1996-01-25  |  4KB  |  191 lines
  1. unit MultiSkelRgn;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types, Events, QuickDraw, Windows, Menus, ToolUtils, TransSkel, MSkelGlobals;
  7.  
  8.     procedure RgnWindInit;
  9.  
  10. implementation
  11.  
  12.     var
  13.  
  14.         rgnPortRect: Rect;
  15.         selectRgn: RgnHandle;
  16.         selectWhen: LongInt;
  17.         selectWhere: Point;
  18.  
  19.         marqueePat: Pattern;
  20.  
  21.  
  22.     procedure MarqueeRgn (r: RgnHandle);
  23.         var
  24.             p: PenState;
  25.             b: Byte;
  26.             i: Integer;
  27.     begin
  28.         GetPenState(p);
  29.         PenPat(marqueePat);
  30.         PenMode(patCopy);
  31.         FrameRgn(r);
  32.         SetPenState(p);
  33.         b := marqueePat.pat[0];            { shift pattern for next call }
  34.         for i := 0 to 7 do
  35.             marqueePat.pat[i] := marqueePat.pat[i + 1];
  36.         marqueePat.pat[7] := b;
  37.     end;
  38.  
  39.  
  40.     procedure DoSelectRect (startPoint: Point;
  41.                                     var dstRect: Rect);
  42.         var
  43.             pt: Point;
  44.             dragPt: Point;
  45.             rClip: Rect;
  46.             port: GrafPtr;
  47.             result: Boolean;
  48.             ps: PenState;
  49.             i: Integer;
  50.             loop: Boolean;
  51.     begin
  52.         GetPort(port);
  53.         rClip := port^.portRect;
  54.         rClip.right := rClip.right - 15;
  55.         GetPenState(ps);
  56.         PenPat(qd.gray);
  57.         PenMode(patXor);
  58.         dragPt := startPoint;
  59.         Pt2Rect(dragPt, dragPt, dstRect);
  60.         FrameRect(dstRect);
  61.         loop := true;
  62.         while (loop) do
  63.             begin
  64.                 GetMouse(pt);
  65.                 if (not EqualPt(pt, dragPt)) then    { mouse has moved, change region }
  66.                     begin
  67.                         FrameRect(dstRect);
  68.                         dragPt := pt;
  69.                         Pt2Rect(dragPt, startPoint, dstRect);
  70.                         result := SectRect(dstRect, rClip, dstRect);
  71.                         FrameRect(dstRect);
  72.                         for i := 0 to 999 do
  73.                             begin
  74.                                 { empty }
  75.                             end;
  76.                     end;
  77.                 if (not StillDown) then
  78.                     loop := false;
  79.             end;
  80.         FrameRect(dstRect);            { erase last rect }
  81.         SetPenState(ps);
  82.     end;
  83.  
  84.  
  85.     procedure Mouse (pt: Point;
  86.                                     t: LongInt;
  87.                                     mods: Integer);
  88.         var
  89.             r: Rect;
  90.             rgn: RgnHandle;
  91.     begin
  92.         r := rgnWind^.portRect;
  93.         if (pt.h >= r.right - 15) then
  94.             exit(Mouse);
  95.         if ((t - selectWhen) <= GetDblTime) then    { it's a double-click }
  96.             begin
  97.                 selectWhen := 0;                { don't take next click as double-click }
  98.                 SetWindClip(rgnWind);
  99.                 EraseRgn(selectRgn);
  100.                 ResetWindClip;
  101.                 SetEmptyRgn(selectRgn);        { clear region }
  102.             end
  103.         else
  104.             begin
  105.                 selectWhen := t;            { update click variables }
  106.                 selectWhere := pt;
  107.                 DoSelectRect(pt, r);        { draw selection rectangle }
  108.                 if (not EmptyRect(r)) then
  109.                     begin
  110.                         EraseRgn(selectRgn);
  111.                         selectWhen := 0;
  112.                         rgn := NewRgn;
  113.                         RectRgn(rgn, r);
  114.                         if (BitAnd(mods, shiftKey) <> 0) then    { test shift key }
  115.                             DiffRgn(selectRgn, rgn, selectRgn)
  116.                         else
  117.                             UnionRgn(selectRgn, rgn, selectRgn);
  118.                         DisposeRgn(rgn);
  119.                     end;
  120.             end;
  121.  
  122.     end;
  123.  
  124.  
  125.     procedure Idle;
  126.         var
  127.             i: Integer;
  128.     begin
  129.         SetWindClip(rgnWind);
  130.         MarqueeRgn(selectRgn);
  131.         ResetWindClip;
  132.     end;
  133.  
  134.  
  135.     procedure Update (resized: Boolean);
  136.         var
  137.             r: Rect;
  138.     begin
  139.         r := rgnWind^.portRect;
  140.         EraseRect(r);
  141.         if (resized) then
  142.             begin
  143.                 rgnPortRect.right := rgnPortRect.right - 15;
  144.                 r.right := r.right - 15;
  145.                 MapRgn(selectRgn, rgnPortRect, r);
  146.                 rgnPortRect := rgnWind^.portRect;
  147.             end;
  148.         DrawGrowBox(rgnWind);
  149.         Idle;
  150.     end;
  151.  
  152.  
  153.     procedure Activate (active: Boolean);
  154.     begin
  155.         DrawGrowBox(rgnWind);
  156.         if (active) then
  157.             DisableItem(editMenu, 0)
  158.         else
  159.             EnableItem(editMenu, 0);
  160.         DrawMenuBar;
  161.     end;
  162.  
  163.  
  164.     procedure Clobber;
  165.     begin
  166.         DisposeRgn(selectRgn);
  167.         DisposeWindow(rgnWind);
  168.     end;
  169.  
  170.  
  171.     procedure RgnWindInit;
  172.         var
  173.             ignore: Boolean;
  174.     begin
  175.         StuffHex(@marqueePat, '0f87c3e1f0783c1e');
  176.  
  177.         if (SkelQuery(skelQHasColorQD) <> 0) then
  178.             rgnWind := GetNewCWindow(rgnWindRes, nil, WindowPtr(-1))
  179.         else
  180.             rgnWind := GetNewWindow(rgnWindRes, nil, WindowPtr(-1));
  181.         if (rgnWind = nil) then
  182.             exit(RgnWindInit);
  183.         ignore := SkelWindow(rgnWind, @Mouse, nil, @Update, @Activate, nil, @Clobber, @Idle, false);
  184.  
  185.         rgnPortRect := rgnWind^.portRect;
  186.         selectRgn := NewRgn;
  187.         selectWhen := 0;
  188.  
  189.     end;
  190.  
  191. end.